home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Especial Multimedia
/
Especial Multimedia.iso
/
Multimed
/
Prg
/
KALENDAR.ZIP
/
TEST4.FRM
< prev
next >
Wrap
Text File
|
1997-09-14
|
7KB
|
247 lines
VERSION 2.00
Begin Form Form4
BorderStyle = 3 'Fixed Double
Caption = "Moon BitBlt"
ClientHeight = 4635
ClientLeft = 3210
ClientTop = 630
ClientWidth = 7710
Height = 5325
Left = 3150
LinkTopic = "Form4"
ScaleHeight = 4635
ScaleWidth = 7710
Top = 0
Width = 7830
Begin Kalendar Kalendar1
ArrowDelay = 500
BackColor = &H00FFFFFF&
CalendarFormat = 0 'Month
ChgOnOtherMon = -1 'True
DateDispStyle = 2 'User
DayAlignment = 0 'Upper Left
DOWAlign = 2 'Center
DOWBackColor = &H00FFFFFF&
DOWBorder = 0 'False
DOWDispStyle = 2 'Medium
DOWFontBold = 0 'False
DOWFontItalic = 0 'False
DOWFontName = "Times New Roman"
DOWFontSize = 12
DOWFontStrikeThru= 0 'False
DOWFontUnderline= 0 'False
DOWForeColor = &H00000000&
EnableKeys = -1 'True
FirstDOW = 0 'Sunday
FixedDayHeight = 0 'False
FontBold = 0 'False
FontItalic = 0 'False
FontName = "Times New Roman"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 4650
Language = 0 'English
Left = 0
LineColor = &H00000000&
MonAlign = 0 'Left
MonBackColor = &H00FFFFFF&
MonDispStyle = 2 'Month/Year
MonFontBold = -1 'True
MonFontItalic = 0 'False
MonFontName = "Arial"
MonFontSize = 18
MonFontStrikeThru= 0 'False
MonFontUnderline= 0 'False
MonForeColor = &H00000000&
OtherMonBackColor= &H00C0C0C0&
OtherMonForeColor= &H00FFFFFF&
SelDayBackColor = &H00C0C0C0&
SelDayForeColor = &H00000000&
ShowAllDays = 0 'False
ShowArrows = -1 'True
ShowLines = -1 'True
ShowSelection = -1 'True
TabIndex = 8
Text = "07/04/94"
TextFormat = 0 'mdy
Top = -15
Width = 6390
End
Begin PictureBox Picture1
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 510
Index = 7
Left = 6735
Picture = TEST4.FRX:0000
ScaleHeight = 510
ScaleWidth = 510
TabIndex = 7
Top = 4185
Width = 510
End
Begin PictureBox Picture1
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 510
Index = 6
Left = 6735
Picture = TEST4.FRX:0302
ScaleHeight = 510
ScaleWidth = 510
TabIndex = 6
Top = 3600
Width = 510
End
Begin PictureBox Picture1
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 510
Index = 5
Left = 6735
Picture = TEST4.FRX:0604
ScaleHeight = 510
ScaleWidth = 510
TabIndex = 5
Top = 2985
Width = 510
End
Begin PictureBox Picture1
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 510
Index = 4
Left = 6735
Picture = TEST4.FRX:0906
ScaleHeight = 510
ScaleWidth = 510
TabIndex = 4
Top = 2415
Width = 510
End
Begin PictureBox Picture1
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 510
Index = 3
Left = 6735
Picture = TEST4.FRX:0C08
ScaleHeight = 510
ScaleWidth = 510
TabIndex = 3
Top = 1785
Width = 510
End
Begin PictureBox Picture1
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 510
Index = 2
Left = 6735
Picture = TEST4.FRX:0F0A
ScaleHeight = 510
ScaleWidth = 510
TabIndex = 2
Top = 1185
Width = 510
End
Begin PictureBox Picture1
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 510
Index = 1
Left = 6735
Picture = TEST4.FRX:120C
ScaleHeight = 510
ScaleWidth = 510
TabIndex = 1
Top = 615
Width = 510
End
Begin PictureBox Picture1
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 510
Index = 0
Left = 6735
Picture = TEST4.FRX:150E
ScaleHeight = 510
ScaleWidth = 510
TabIndex = 0
Top = 0
Width = 510
End
Begin Menu mnuFile
Caption = "&File"
Begin Menu mnuFPrint
Caption = "&Print"
End
End
End
Option Explicit
Sub Form_Activate ()
SetDescription Sample4Description()
End Sub
Sub Form_Load ()
Kalendar1.Text = Date
End Sub
Sub Form_Resize ()
Kalendar1.Move 0, 0, Form4.ScaleWidth, Form4.ScaleHeight
End Sub
Sub Kalendar1_DrawOnDay (hDC As Integer, STATE As Integer, theDay As Long, x As Single, y As Single, x2 As Single, y2 As Single)
Dim retval As Integer
Dim xr As Rect
Dim w As Long
KalDrawBitmap hDC, Picture1(theDay Mod 8), x, y, x2, y2, 8, SRCAND
If theDay < Date Then
KalWindowAPIRect x, y, x2, y2, xr
InflateRect xr, -1, -1
w = MoveTo(hDC, xr.left, xr.top)
retval = LineTo(hDC, xr.right, xr.bottom)
w = MoveTo(hDC, xr.right, xr.top)
retval = LineTo(hDC, xr.left, xr.bottom)
End If
End Sub
Sub Kalendar1_QueryChangeDay (theDay As Long, Cancel As Integer)
If theDay < Date Then
Beep
Cancel = True
End If
End Sub
Sub mnuFPrint_Click ()
Dim saveBackColor As Long
saveBackColor = Kalendar1.MonBackColor
Kalendar1.MonBackColor = RGB(255, 255, 255)
Kalendar1.PrintHDC = Printer.hDC
Kalendar1.PrintAction = KAL_PRINT_LANDSCAPE
Kalendar1.MonBackColor = saveBackColor
Printer.EndDoc
End Sub
Function Sample4Description () As String
Dim s As String
s = "This is another of the DrawOnDay event. The moons are drawn by using the API call BitBlt and seven different picture boxes." & CR
s = s & "Also shown is a use of the QueryChangeDay event. You cannot access dates previous to today."
Sample4Description = s
End Function